#!/usr/bin/perl -w
#******************************************************************************
#*                    
#*                           GELLYFISH SOFTWARE           
#*                                                       
#******************************************************************************
#*
#*          PROGRAM      :   dir2html.pl
#*
#*          AUTHOR       :   JNS (jns@gellyfish.com)
#*
#*          DESCRIPTION  :   Create an HTML index page
#*
#*****************************************************************************
#*
#*          $Log: dir2html.pl,v $
#*          Revision 1.1  2004/10/13 12:13:49  jonathan
#*          Initial revision
#*
#*          Revision 1.7  2003/08/09 10:44:28  gellyfish
#*          * removed useless BEGIN and main() subroutine
#*
#*          Revision 1.6  1999/10/02 12:19:23  gellyfish
#*          Put subs in begin block
#*          added %conf hash
#*          strict safe
#*
#*          Revision 1.5  1998/02/24 21:52:30  jns
#*          * Restructured the code
#*
#*          Revision 1.4  1998/02/24 00:54:47  jns
#*          * Added INI file
#*          * Added POD
#*
#*          Revision 1.3  1998/02/14 22:05:08  jns
#*          Recurses directories.
#*          Uses HTML::HeadParse.
#*
#*          Revision 1.2  1998/02/14 14:51:48  jns
#*          Added options for output file and directory
#*
#*          Revision 1.1  97/11/06  23:48:49  jns
#*          Initial revision
#* 
#*
#*****************************************************************************/ 

$VERSION='$Revision: 1.1 $';

use strict;
use vars qw($VERSION $progname $progpath $revision);
require HTML::HeadParser;
use Getopt::Std;
use File::Basename;
use IniConf;

($progname,$progpath,undef) = fileparse($0,".pl");

($revision) = $VERSION =~ /Revision: (.+)\s\$$/;

   my $config = doconfig();
   header($config);
   startbody($config);

   my @dirlist = ($config->{start_dir});

   my $newdir;

   while(my $the_dir = shift @dirlist)
   {
      my  $dirtitle;

      $newdir = 0;

      opendir CURDIR, $the_dir or die "Cant open directory $the_dir: ",$!;
      my @current_dir = sort grep !/^\./ ,readdir CURDIR;
      close CURDIR;

      my $thisindex = $the_dir . "/" . $config->{indexpage};
      if ( -f $thisindex )
        {
             my $parser = HTML::HeadParser->new;
             $parser->parse_file($thisindex);
             $dirtitle = $parser->header('Title');
             if (defined $config->{translatedir})
               {
                $thisindex =~ s|^$config->{start_dir}|$config->{rootname}|g;
               }
             $dirtitle = qq|<A HREF="$thisindex">$dirtitle</A>|;
        }
      else
        {
             $dirtitle = $config->{defdirtitle} . $the_dir;
        }


      for my $filename ( @current_dir)
         {
            next if ($filename =~ /^\./ || $filename =~ /rcs$/i );
            next if ( $filename eq $config->{indexpage});
            $filename = $the_dir . "/" . $filename ;
            if ( -d $filename )
              {
                push @dirlist,$filename ;
                next ;
              }
            if ( $filename =~ /html?$/ )
              {
                unless ($newdir++)
                  {
                   print "   <LI><H2>$dirtitle</H2>\n   <UL>\n" ;
                  }

                my $parser = HTML::HeadParser->new;
                $parser->parse_file($filename);
                my $outtitle = $parser->header('Title');
                my $outdescription = $parser->header('X-Meta-Description');
                $outtitle = basename($filename) unless $outtitle;
                detail($filename,$outtitle,$outdescription,$config);
              }
          }
      print "      </UL>\n<P>\n" if ($newdir);
   }
   endpage();


sub doconfig()
{
   my %opts;

   my %conf_hash;

# some defaults

   $conf_hash{indexpage} = 'index.htm' ;
   $conf_hash{doctype} = '<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML 3.2//EN">';
   $conf_hash{defdirtitle} = 'Contents of ';
   $conf_hash{pagetitle} = ' ' ; 
   $conf_hash{heading} = ' ' ;

   getopts('f:t:h:d:o:i:r:',\%opts) || usage();

   if ( defined $opts{d} )
     {
      $conf_hash{start_dir} = $opts{d};
      if ( defined $opts{r} )
        {
          $conf_hash{translatedir}++ ;
          $conf_hash{rootname} = $opts{r} ;
        }
     }
   else
     {
      $conf_hash{start_dir} = ".";
      }


   if (defined $opts{o})
     {
      open ( OUTFILE,">$opts{o}") || die "Cant open $opts{o} : $!\n";
      select(OUTFILE);
     }

   my $got_ini = 0;

   my $inifile = $opts{f} || $conf_hash{start_dir} ."/" . $progname . ".ini";

   my $cfg;

   if ( -f $inifile )
     {
       $cfg = IniConf->new(-file => $inifile );
       $got_ini = 1;
     }
   else 
     {
       $inifile = $progpath . "/" . $progname . ".ini";
       if ( -f $inifile )
         {
           $cfg = IniConf->new(-file => $inifile );
           $got_ini = 1;
         }
     }

   if ($got_ini)
     {
       $conf_hash{doctype} = $cfg->val("defaults","doctype");
       $conf_hash{defdirtitle} = $cfg->val("defaults","dirtitle");
     }

   if (defined $opts{i})
     {
       $conf_hash{indexpage} = $opts{i};
     }
   elsif ( $got_ini )
     {
       $conf_hash{indexpage} = $cfg->val("defaults","indexpage");
     }

   if (defined $opts{t})
     {
       $conf_hash{pagetitle} = $opts{t};
     }
   elsif ($got_ini )
     {
      $conf_hash{pagetitle} = $cfg->val("defaults","pagetitle");
     }

   if (defined $opts{h})
     {
       $conf_hash{heading} = $opts{h};
     }
   elsif ($got_ini )
     {
      $conf_hash{heading} = $cfg->val("defaults","heading");
     }

   return \%conf_hash;
}

sub endpage()
{
  print "</UL>\n</BODY>\n</HTML>\n";
}

sub header()
{
   my $config = shift;
   print $config->{doctype},"\n";
   print "<HTML>\n<HEAD>\n";
   print qq|   <META NAME="GENERATOR" CONTENT="$progname $revision">\n|;

   print "   <TITLE>$config->{pagetitle}</TITLE>\n";
   print "</HEAD>\n";
}

sub startbody()
{
   my $config = shift ;
   print "<BODY>\n";
   print "<CENTER><H1>$config->{heading}</H1></CENTER>\n";
   print "<UL>\n";
}

sub detail()
{
   my ($filename,$outtitle,$outdescription,$config) = @_;
   if (defined $config->{translatedir})
     {
       $filename =~ s|$config->{start_dir}|$config->{rootname}|g;
     }
   print <<EEBYGUM;
      <LI>
         <TABLE>
            <TR VALIGN="TOP">
               <TD>
                  <A HREF="$filename">$outtitle</A>
               </TD>
            </TR>
EEBYGUM
   if ($outdescription)
     {
       print <<EKKYTHUMP;
            <TR>
               <TD>
                  $outdescription
               </TD>
            </TR>
EKKYTHUMP
           }
   print "         </TABLE>\n";
}

sub usage()
{
  my $pad = " " x length($progname);
  die <<BLAH;
USAGE : $progname [-d <DIR>]       
        $pad [-o <OUTFILE>]
        $pad [-t <TITLE>] 
        $pad [-h <HEADING>]
        $pad [-i <INDEXFILE>]
        $pad [-r <ROOTDIR>]
BLAH
}


__END__

=head1 NAME

B<dir2html>

=head1 SYNOPSIS

B<dir2html> [-d <DIR>] [-o <OUTFILE>] [-t <TITLE>] [-h <HEADING>] [-i <INDEXFILE>] [-r <ROOTDIR>]

=head1 DESCRIPTION

B<dir2html> is a utility to produce an HTML index file for an entire directory
structure. It has the facility to rewrite the filesystem path to reflect a
servers directory setup.  If a named file is present in a visited directory
the details from this file are used to title the directory.  Where it is present the
META tag "Description" is used to provide some descriptive text for each file.

=head1 USAGE

=head1 METHODS

=head1 DIAGNOSTICS

=head1 BUGS

=over 3

=item * The directory rewriting facility is not entirely as sophisticated 
as it might be.

=item * It should be possible to name more than one starting directory on the
command line.  At present only the last named is used.

=item * The use of only the "Description" meta tag is a bit restrictive.

=item * A more intelligent technique could be used in the face of a missing title.

=item * The method of dealing with the INI files could be cleaner.

=item * Extremely untidy code.

=back

=head1 VERSION

 Still under development

=head1 AUTHOR

=head2 Jonathan Stowe.  <jns@gellyfish.com>

=head1 COPYRIGHT

Copyright (c) 1998-2003 Jonathan Stowe. All rights reserved. This program
is free software; you can redistribute it and/or modify it under the
same terms as Perl itself.

=cut
